home *** CD-ROM | disk | FTP | other *** search
/ Ultimate Screensaver / Ultimate Screen Savers Collection (CMS Distributing) (1996).ISO / saver3 / guitoons / guitoons.frm < prev    next >
Text File  |  1995-03-15  |  14KB  |  492 lines
  1. VERSION 2.00
  2. Begin Form frmScrSave 
  3.    BackColor       =   &H00000000&
  4.    BorderStyle     =   0  'None
  5.    Caption         =   "GUIToons"
  6.    ClientHeight    =   1200
  7.    ClientLeft      =   1650
  8.    ClientTop       =   1755
  9.    ClientWidth     =   5340
  10.    Height          =   1725
  11.    Icon            =   GUITOONS.FRX:0000
  12.    Left            =   1590
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   1200
  15.    ScaleWidth      =   5340
  16.    Top             =   1290
  17.    Width           =   5460
  18.    Begin PictureBox picLoader 
  19.       Height          =   855
  20.       Left            =   3600
  21.       ScaleHeight     =   825
  22.       ScaleWidth      =   825
  23.       TabIndex        =   3
  24.       Top             =   180
  25.       Width           =   855
  26.    End
  27.    Begin PictureBox picScreenCap 
  28.       Height          =   855
  29.       Left            =   2490
  30.       ScaleHeight     =   825
  31.       ScaleWidth      =   825
  32.       TabIndex        =   2
  33.       Top             =   180
  34.       Width           =   855
  35.    End
  36.    Begin PictureBox picWorkSpace 
  37.       Height          =   855
  38.       Left            =   1350
  39.       ScaleHeight     =   825
  40.       ScaleWidth      =   825
  41.       TabIndex        =   1
  42.       Top             =   180
  43.       Width           =   855
  44.    End
  45.    Begin PictureBox picPicture 
  46.       Height          =   855
  47.       Index           =   0
  48.       Left            =   240
  49.       ScaleHeight     =   825
  50.       ScaleWidth      =   825
  51.       TabIndex        =   0
  52.       Top             =   180
  53.       Width           =   855
  54.    End
  55.    Begin Timer Timer1 
  56.       Enabled         =   0   'False
  57.       Interval        =   55
  58.       Left            =   4680
  59.       Top             =   180
  60.    End
  61. End
  62. DefInt A-Z
  63. Option Explicit
  64. Dim JustAMoment%
  65. '  Upon receiving a bad password or cancel, Unload sets
  66. '  JustAMoment to TRUE. The timer sets it to FALSE on its
  67. '  next event. In between, the screen saver ignores events
  68. '  like the mouse-up from the cancel button
  69.  
  70. Sub Form_Click ()
  71.  
  72.   If Not JustAMoment Then Unload Me
  73.  
  74. End Sub
  75.  
  76. Sub Form_KeyPress (KeyAscii As Integer)
  77.  
  78.   If Not JustAMoment Then Unload Me
  79.  
  80. End Sub
  81.  
  82. Sub Form_Load ()
  83.   Randomize Timer
  84.   JustAMoment = False
  85.     '-- Setup screen?
  86.   If InStr(Command$, "/c") Then
  87.     frmSetup.Show 1
  88.     Me.Visible = False
  89.     Exit Sub
  90.   End If
  91.  
  92.   Dim Success%
  93.  
  94. '-- Read setup data from the CONTROL.INI file
  95.  
  96.     '-- NumBitmaps
  97.   NumBitmaps = ReadInt("NumBitmaps", 0)
  98.   If NumBitmaps = 0 Then
  99.     MsgBox "No bitmaps have been selected. Press Ok to set up", 16, "GUIToons"
  100.     frmSetup.Show 1
  101.     End
  102.   End If
  103.     
  104.     '-- Hide the cursor
  105.   HideCursor
  106.  
  107.     '-- MoveSpeed
  108.   MoveSpeed = ReadInt("MoveSpeed", 10)
  109.   If MoveSpeed < 1 Then MoveSpeed = 10
  110.  
  111.   Dim Interval&, i%
  112.  
  113.     '-- Animation Interval
  114.   Interval = ReadInt("Interval", 1)
  115.   If Interval < 1 Then Interval = 1
  116.   Timer1.Interval = Interval& * 56
  117.   
  118.     '-- Background
  119.   ClearScreen% = ReadInt("ClearScreen", False)
  120.  
  121.     '-- Load pictures controls and redim's an array to hold
  122.     '   Device Context handles.
  123.   For i = 1 To NumBitmaps - 1
  124.     Load picPicture(i)
  125.   Next
  126.   ReDim DC(0 To NumBitmaps - 1) As DCType
  127.  
  128.     '-- Initialize the Picture Loader Control
  129.   picLoader.AutoRedraw = True
  130.   picLoader.Visible = False
  131.   picLoader.Left = Screen.Width + 1
  132.   picLoader.BorderStyle = 0
  133.  
  134.     '-- Grab the screen's DC
  135.   ScreenDC = CreateDC("DISPLAY", "", "", "")
  136.  
  137.   Dim FileName$, KeyName$
  138.     '-- Load the first bitmap to determine the size of the picture
  139.     '   controls (including the MoveSpeed).
  140.   FileName$ = ReadString$("Bitmap1")
  141.   If Len(FileName$) Then
  142.     On Error Resume Next
  143.     picLoader.Picture = LoadPicture(FileName$)
  144.     picLoader.AutoSize = True
  145.     If Err Then
  146.       Beep
  147.       Success = ShowCursor(True)
  148.       MsgBox "Error Loading Bitmap File: " & UCase$(FileName$), 0, "GUIToons"
  149.       End
  150.     End If
  151.   End If
  152.  
  153.   Dim realbWidth!, realbHeight!, twipWidth&, twipHeight&
  154.     '-- Determine Width and Height variables
  155.   picLoader.ScaleMode = 3
  156.   realbWidth = picLoader.ScaleWidth
  157.   realbHeight = picLoader.ScaleHeight
  158.   bWidth = realbWidth + (MoveSpeed * 2)
  159.   bHeight = realbHeight + (MoveSpeed * 2)
  160.   twipWidth = bWidth * Screen.TwipsPerPixelX
  161.   twipHeight = bHeight * Screen.TwipsPerPixelY
  162.  
  163.     '-- Set up the WorkSpace picture
  164.   picWorkSpace.Height = twipHeight
  165.   picWorkSpace.Width = twipWidth
  166.   picWorkSpace.AutoRedraw = True
  167.   picWorkSpace.Visible = False
  168.   picWorkSpace.BorderStyle = 0
  169.   picWorkSpace.Left = Screen.Width + 1
  170.   WorkDC = picWorkSpace.hDC
  171.  
  172.     '-- Set up the ScreenCap picture
  173.   picScreenCap.Visible = False
  174.   picScreenCap.Left = Screen.Width + 1
  175.   If ClearScreen% Then
  176.     ' don't bother setting up to save the screen
  177.   Else
  178.     picScreenCap.Height = Screen.Height
  179.     picScreenCap.Width = Screen.Width
  180.     picScreenCap.AutoRedraw = True
  181.     picScreenCap.BorderStyle = 0
  182.     ScreenCapDC = picScreenCap.hDC
  183.   End If
  184.  
  185.  
  186.   Dim LoaderDC%, BColor&, OldColor&, TempBMP%, TempDC%, OldBMP%, Dummy%
  187.  
  188.     '-- Load Bitmaps
  189.   For i = 0 To NumBitmaps - 1
  190.  
  191.         '-- Hide the animation picture controls.
  192.         '-- Set Hidden picture controls' AutoRedraw True.
  193.         '   They will not hold their pictures' data in memory
  194.         '   if you do not set AutoRedraw True.
  195.     picPicture(i).AutoRedraw = True
  196.     picPicture(i).Visible = False
  197.     picPicture(i).Left = Screen.Width + 1
  198.     picPicture(i).AutoSize = False
  199.     picPicture(i).Width = twipWidth
  200.     picPicture(i).Height = twipHeight
  201.     picPicture(i).BorderStyle = 0
  202.  
  203.         '-- Load the next file.
  204.     KeyName$ = "Bitmap" & LTrim$(Str$(i + 1))
  205.     FileName$ = ReadString$(KeyName$)
  206.     If Len(FileName$) = 0 Then
  207.       Beep
  208.       Success = ShowCursor(True)
  209.       MsgBox "No Bitmaps Specified. You must set up the screen saver with the Control Panel's 'Desktop' applet", 16, "GUIToons"
  210.       End
  211.     End If
  212.     On Error Resume Next
  213.     picLoader.Picture = LoadPicture(FileName$)
  214.     DoEvents
  215.     If Err Then
  216.       Beep
  217.       Success = ShowCursor(True)
  218.       MsgBox "Screen Saver Error - Cannot Find Bitmap File: " & UCase$(FileName$), 16, "GUIToons"
  219.       End
  220.     End If
  221.  
  222.         '-- DC(x) is an array of DC values (integer array)
  223.     DC(i).IntPicDC = picPicture(i).hDC
  224.     LoaderDC = picLoader.hDC
  225.  
  226.         '-- The Background color of the DC must be set to the same as
  227.         '   the upper-left hand pixel color in order to create the mask.
  228.     BColor& = GetPixel&(LoaderDC, 0, 0)
  229.     OldColor& = SetBkColor&(DC(i).IntPicDC, BColor&)
  230.     picPicture(i).BackColor = BColor&
  231.     picPicture(i).Refresh
  232.  
  233.         '-- Copy the image from the picLoader control to the picPicture
  234.         '   control for this frame
  235.     DC(i).IntPicDC = picPicture(i).hDC
  236.     Success = BitBlt(DC(i).IntPicDC, MoveSpeed, MoveSpeed, realbWidth, realbHeight, LoaderDC, 0, 0, SRCCOPY)
  237.  
  238.         '-- Create mask from the picture:
  239.  
  240.         '-- Create the mask DC, and a bitmap to go in it.
  241.     DC(i).IntMaskDC = CreateCompatibleDC(ScreenDC)
  242.     DC(i).intMaskBmp = CreateCompatibleBitmap(ScreenDC, bWidth, bHeight)
  243.  
  244.         '-- Move the bitmap into the Mask DC
  245.     DC(i).intOldMaskBmp = SelectObject(DC(i).IntMaskDC, DC(i).intMaskBmp)
  246.  
  247.         '-- Create a monochrome bitmap that will be the mask bitmap.
  248.     TempBMP = CreateBitmap(bWidth, bHeight, 1, 1, 0&)
  249.  
  250.         '-- Create a temporary DC, and put the mask bitmap into it
  251.     TempDC = CreateCompatibleDC(ScreenDC)
  252.     OldBMP = SelectObject(TempDC, TempBMP)
  253.  
  254.         '-- Copy the picture into the temporary compatible DC
  255.     Success = BitBlt(TempDC, 0, 0, bWidth, bHeight, DC(i).IntPicDC, 0, 0, SRCCOPY)
  256.         '-- Copy the compatible DC into the mask (mono) DC
  257.     Success = BitBlt(DC(i).IntMaskDC, 0, 0, bWidth, bHeight, TempDC, 0, 0, SRCCOPY)
  258.  
  259.         '-- Clean up
  260.     TempBMP = SelectObject(TempDC, OldBMP)
  261.     Dummy = DeleteObject(TempBMP)
  262.     Dummy = DeleteDC(TempDC)
  263.  
  264.   Next
  265.  
  266.     '-- Set up the form.
  267.   Me.ScaleMode = 3
  268.   Me.Width = Screen.Width
  269.   Me.Height = Screen.Height
  270.   Me.Top = 0
  271.   Me.Left = 0
  272.   Me.AutoRedraw = True
  273.   pixWidth = M